home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Toolbox
/
Visual Basic Toolbox (P.I.E.)(1996).ISO
/
boxes
/
demo2
/
demo2.bas
< prev
next >
Wrap
BASIC Source File
|
1995-03-30
|
6KB
|
178 lines
' The following Declares and constants were taken from WIN30API.TXT
' that ships with the Visual Basic Professional Edition. Get used to the API
' my friends and the world is yours. I was afraid of it for way too long.
'
Declare Function GetWindowTextLength Lib "user" (ByVal hwnd%) As Integer
Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
Declare Function GetSystemDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
Declare Function GetModuleUsage Lib "Kernel" (ByVal hModule As Integer) As Integer
Declare Function SetFocusAPI Lib "User" Alias "SetFocus" (ByVal hwnd As Integer) As Integer
Declare Function GetDeskTopWindow Lib "User" () As Integer
Declare Function GetWindow Lib "User" (ByVal hwnd As Integer, ByVal wCmd As Integer) As Integer
Declare Function GetWindowText Lib "User" (ByVal hwnd As Integer, ByVal lpString As String, ByVal aint As Integer) As Integer
Declare Function GetClassName Lib "User" (ByVal hwnd As Integer, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
Declare Function GetParent Lib "User" (ByVal hwnd As Integer) As Integer
Declare Function GetWindowWord Lib "User" (ByVal hwnd As Integer, ByVal nIndex As Integer) As Integer
Global Const GW_HWNDNEXT = 2
Global Const GW_CHILD = 5
Global Const GWW_ID = (-12)
Global Const SW_HIDE = 0
Global Const SW_NORMAL = 1
Global Const SW_MAXIMIZE = 3
Global Const SW_MINIMIZE = 6
'This does nothing except waste time while the shelled App
'is doing it's thing. I wanted to have the user modify the
'INI file using Notepad and since I needed to re-read the
'file I basically am forced to wait until the user is done.
'
Function DOShell (ShellString As String, WinType As Integer)
Dim InstanceHandle As Integer, HowMuchUsage As Integer
InstanceHandle = Shell(ShellString, WinType)
Do While GetModuleUsage(InstanceHandle) > 0
HowMuchUsage = DoEvents()
Loop
End Function
'FindWindowLike
' - The FindWindowLike function finds the hWnds of the windows
' matching the specified parameters
'
'hwndArray()
' - An integer array used to return the window handles
'
'hWndStart
' - The handle of the window to search under.
' - The routine searches through all of this window's children and their
' children recursively.
' - If hWndStart = 0 then the routine searches through all windows.
'
'WindowText
' - The pattern used with the Like operator to compare window's text.
'
'ClassName
' - The pattern used with the Like operator to compare window's class
' name.
'
'ID
' - A child ID number used to identify a window.
' - Can be a decimal number or a hex string.
' - Prefix hex strings with "&H" or an error will occur.
' - To ignore the ID pass the Visual Basic Null function.
'
'
Function FindWindowLike (hWndArray() As Integer, ByVal hWndStart As Integer, WindowText As String, Classname As String, ID) As Integer
Dim hwnd As Integer
Dim sWindowText As String
Dim r As Integer
' Hold the level of recursion:
Static level As Integer
' Hold the number of matching windows:
Static iFound As Integer
' Initialize if necessary:
If level = 0 Then
iFound = 0
ReDim hWndArray(0 To 0)
If hWndStart = 0 Then hWndStart = GetDeskTopWindow()
End If
' Increase recursion counter:
level = level + 1
' Get first child window:
hwnd = GetWindow(hWndStart, GW_CHILD)
Do Until hwnd = 0
DoEvents ' Not necessary
' Search children by recursion:
r = FindWindowLike(hWndArray(), hwnd, WindowText, Classname, ID)
' Get the window text and class name:
sWindowText = Space(255)
r = GetWindowText(hwnd, sWindowText, 255)
sWindowText = Left(sWindowText, r)
sClassname = Space(255)
r = GetClassName(hwnd, sClassname, 255)
sClassname = Left(sClassname, r)
' If window is a child get the ID:
If GetParent(hwnd) <> 0 Then
r = GetWindowWord(hwnd, GWW_ID)
sID = CLng("&H" & Hex(r))
Else
sID = Null
End If
' Check that window matches the search parameters:
If sWindowText Like WindowText And sClassname Like Classname Then
If IsNull(ID) Then
' If find a match, increment counter and add handle to array:
iFound = iFound + 1
ReDim Preserve hWndArray(0 To iFound)
hWndArray(iFound) = hwnd
ElseIf Not IsNull(sID) Then
If sID = CLng(ID) Then
' If find a match increment counter and add handle to array:
iFound = iFound + 1
ReDim Preserve hWndArray(0 To iFound)
hWndArray(iFound) = hwnd
End If
End If
End If
' Get next child window:
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
' Decrement recursion counter:
level = level - 1
' Return the number of windows found:
FindWindowLike = iFound
End Function
' Uses the Windows API to get the Windows directory
' which defaults to C:\Windows but we all know better
' don't we. Heck, everyone feels the need to put
' Windows where _they_ want it.
'
Function GetWindowsDir () As String
temp$ = String$(145, 0) ' Size Buffer
X = GetWindowsDirectory(temp$, 145) ' Make API Call
temp$ = Left$(temp$, X) ' Trim Buffer
If Right$(temp$, 1) <> "\" Then ' Add \ if necessary
GetWindowsDir$ = temp$ + "\"
Else
GetWindowsDir$ = temp$
End If
End Function
' Uses the Windows API to get the Windows System directory
' which defaults to C:\Windows\System but we all know better
' don't we. Heck, everyone feels the need to put
' Windows where _they_ want it.
'
Function GetWindowsSysDir () As String
temp$ = String$(145, 0) ' Size Buffer
X = GetSystemDirectory(temp$, 145) ' Make API Call
temp$ = Left$(temp$, X) ' Trim Buffer
If Right$(temp$, 1) <> "\" Then ' Add \ if necessary
GetWindowsSysDir$ = temp$ + "\"
Else
GetWindowsSysDir$ = temp$
End If
End Function